<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
 <head>
  <title>clacn2.f</title>
 <meta name="generator" content="emacs 21.3.1; htmlfontify 0.20">
<style type="text/css"><!-- 
body { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default   { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default a { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
span.string   { color: rgb(188, 143, 143);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.string a { color: rgb(188, 143, 143);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
span.comment   { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.comment a { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
 --></style>

 </head>
  <body>

<pre>
      SUBROUTINE <a name="CLACN2.1"></a><a href="clacn2.f.html#CLACN2.1">CLACN2</a>( N, V, X, EST, KASE, ISAVE )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  -- LAPACK auxiliary routine (version 3.1) --
</span><span class="comment">*</span><span class="comment">     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
</span><span class="comment">*</span><span class="comment">     November 2006
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Scalar Arguments ..
</span>      INTEGER            KASE, N
      REAL               EST
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Array Arguments ..
</span>      INTEGER            ISAVE( 3 )
      COMPLEX            V( * ), X( * )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Purpose
</span><span class="comment">*</span><span class="comment">  =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  <a name="CLACN2.19"></a><a href="clacn2.f.html#CLACN2.1">CLACN2</a> estimates the 1-norm of a square, complex matrix A.
</span><span class="comment">*</span><span class="comment">  Reverse communication is used for evaluating matrix-vector products.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Arguments
</span><span class="comment">*</span><span class="comment">  =========
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  N      (input) INTEGER
</span><span class="comment">*</span><span class="comment">         The order of the matrix.  N &gt;= 1.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  V      (workspace) COMPLEX array, dimension (N)
</span><span class="comment">*</span><span class="comment">         On the final return, V = A*W,  where  EST = norm(V)/norm(W)
</span><span class="comment">*</span><span class="comment">         (W is not returned).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  X      (input/output) COMPLEX array, dimension (N)
</span><span class="comment">*</span><span class="comment">         On an intermediate return, X should be overwritten by
</span><span class="comment">*</span><span class="comment">               A * X,   if KASE=1,
</span><span class="comment">*</span><span class="comment">               A' * X,  if KASE=2,
</span><span class="comment">*</span><span class="comment">         where A' is the conjugate transpose of A, and <a name="CLACN2.36"></a><a href="clacn2.f.html#CLACN2.1">CLACN2</a> must be
</span><span class="comment">*</span><span class="comment">         re-called with all the other parameters unchanged.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  EST    (input/output) REAL
</span><span class="comment">*</span><span class="comment">         On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
</span><span class="comment">*</span><span class="comment">         unchanged from the previous call to <a name="CLACN2.41"></a><a href="clacn2.f.html#CLACN2.1">CLACN2</a>.
</span><span class="comment">*</span><span class="comment">         On exit, EST is an estimate (a lower bound) for norm(A). 
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  KASE   (input/output) INTEGER
</span><span class="comment">*</span><span class="comment">         On the initial call to <a name="CLACN2.45"></a><a href="clacn2.f.html#CLACN2.1">CLACN2</a>, KASE should be 0.
</span><span class="comment">*</span><span class="comment">         On an intermediate return, KASE will be 1 or 2, indicating
</span><span class="comment">*</span><span class="comment">         whether X should be overwritten by A * X  or A' * X.
</span><span class="comment">*</span><span class="comment">         On the final return from <a name="CLACN2.48"></a><a href="clacn2.f.html#CLACN2.1">CLACN2</a>, KASE will again be 0.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  ISAVE  (input/output) INTEGER array, dimension (3)
</span><span class="comment">*</span><span class="comment">         ISAVE is used to save variables between calls to <a name="SLACN2.51"></a><a href="slacn2.f.html#SLACN2.1">SLACN2</a>
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Further Details
</span><span class="comment">*</span><span class="comment">  ======= =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Contributed by Nick Higham, University of Manchester.
</span><span class="comment">*</span><span class="comment">  Originally named CONEST, dated March 16, 1988.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Reference: N.J. Higham, &quot;FORTRAN codes for estimating the one-norm of
</span><span class="comment">*</span><span class="comment">  a real or complex matrix, with applications to condition estimation&quot;,
</span><span class="comment">*</span><span class="comment">  ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Last modified:  April, 1999
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  This is a thread safe version of <a name="CLACON.65"></a><a href="clacon.f.html#CLACON.1">CLACON</a>, which uses the array ISAVE
</span><span class="comment">*</span><span class="comment">  in place of a SAVE statement, as follows:
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     <a name="CLACON.68"></a><a href="clacon.f.html#CLACON.1">CLACON</a>     <a name="CLACN2.68"></a><a href="clacn2.f.html#CLACN2.1">CLACN2</a>
</span><span class="comment">*</span><span class="comment">      JUMP     ISAVE(1)
</span><span class="comment">*</span><span class="comment">      J        ISAVE(2)
</span><span class="comment">*</span><span class="comment">      ITER     ISAVE(3)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  =====================================================================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Parameters ..
</span>      INTEGER              ITMAX
      PARAMETER          ( ITMAX = 5 )
      REAL                 ONE,         TWO
      PARAMETER          ( ONE = 1.0E0, TWO = 2.0E0 )
      COMPLEX              CZERO, CONE
      PARAMETER          ( CZERO = ( 0.0E0, 0.0E0 ),
     $                            CONE = ( 1.0E0, 0.0E0 ) )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Local Scalars ..
</span>      INTEGER            I, JLAST
      REAL               ABSXI, ALTSGN, ESTOLD, SAFMIN, TEMP
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Functions ..
</span>      INTEGER            <a name="ICMAX1.89"></a><a href="icmax1.f.html#ICMAX1.1">ICMAX1</a>
      REAL               <a name="SCSUM1.90"></a><a href="scsum1.f.html#SCSUM1.1">SCSUM1</a>, <a name="SLAMCH.90"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>
      EXTERNAL           <a name="ICMAX1.91"></a><a href="icmax1.f.html#ICMAX1.1">ICMAX1</a>, <a name="SCSUM1.91"></a><a href="scsum1.f.html#SCSUM1.1">SCSUM1</a>, <a name="SLAMCH.91"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Subroutines ..
</span>      EXTERNAL           CCOPY
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Intrinsic Functions ..
</span>      INTRINSIC          ABS, AIMAG, CMPLX, REAL
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Executable Statements ..
</span><span class="comment">*</span><span class="comment">
</span>      SAFMIN = <a name="SLAMCH.101"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>( <span class="string">'Safe minimum'</span> )
      IF( KASE.EQ.0 ) THEN
         DO 10 I = 1, N
            X( I ) = CMPLX( ONE / REAL( N ) )
   10    CONTINUE
         KASE = 1
         ISAVE( 1 ) = 1
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      GO TO ( 20, 40, 70, 90, 120 )ISAVE( 1 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 1)
</span><span class="comment">*</span><span class="comment">     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X.
</span><span class="comment">*</span><span class="comment">
</span>   20 CONTINUE
      IF( N.EQ.1 ) THEN
         V( 1 ) = X( 1 )
         EST = ABS( V( 1 ) )
<span class="comment">*</span><span class="comment">        ... QUIT
</span>         GO TO 130
      END IF
      EST = <a name="SCSUM1.123"></a><a href="scsum1.f.html#SCSUM1.1">SCSUM1</a>( N, X, 1 )
<span class="comment">*</span><span class="comment">
</span>      DO 30 I = 1, N
         ABSXI = ABS( X( I ) )
         IF( ABSXI.GT.SAFMIN ) THEN
            X( I ) = CMPLX( REAL( X( I ) ) / ABSXI,
     $               AIMAG( X( I ) ) / ABSXI )
         ELSE
            X( I ) = CONE
         END IF
   30 CONTINUE
      KASE = 2
      ISAVE( 1 ) = 2
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 2)
</span><span class="comment">*</span><span class="comment">     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
</span><span class="comment">*</span><span class="comment">
</span>   40 CONTINUE
      ISAVE( 2 ) = <a name="ICMAX1.142"></a><a href="icmax1.f.html#ICMAX1.1">ICMAX1</a>( N, X, 1 )
      ISAVE( 3 ) = 2
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
</span><span class="comment">*</span><span class="comment">
</span>   50 CONTINUE
      DO 60 I = 1, N
         X( I ) = CZERO
   60 CONTINUE
      X( ISAVE( 2 ) ) = CONE
      KASE = 1
      ISAVE( 1 ) = 3
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 3)
</span><span class="comment">*</span><span class="comment">     X HAS BEEN OVERWRITTEN BY A*X.
</span><span class="comment">*</span><span class="comment">
</span>   70 CONTINUE
      CALL CCOPY( N, X, 1, V, 1 )
      ESTOLD = EST
      EST = <a name="SCSUM1.162"></a><a href="scsum1.f.html#SCSUM1.1">SCSUM1</a>( N, V, 1 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     TEST FOR CYCLING.
</span>      IF( EST.LE.ESTOLD )
     $   GO TO 100
<span class="comment">*</span><span class="comment">
</span>      DO 80 I = 1, N
         ABSXI = ABS( X( I ) )
         IF( ABSXI.GT.SAFMIN ) THEN
            X( I ) = CMPLX( REAL( X( I ) ) / ABSXI,
     $               AIMAG( X( I ) ) / ABSXI )
         ELSE
            X( I ) = CONE
         END IF
   80 CONTINUE
      KASE = 2
      ISAVE( 1 ) = 4
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 4)
</span><span class="comment">*</span><span class="comment">     X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
</span><span class="comment">*</span><span class="comment">
</span>   90 CONTINUE
      JLAST = ISAVE( 2 )
      ISAVE( 2 ) = <a name="ICMAX1.186"></a><a href="icmax1.f.html#ICMAX1.1">ICMAX1</a>( N, X, 1 )
      IF( ( ABS( X( JLAST ) ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND.
     $    ( ISAVE( 3 ).LT.ITMAX ) ) THEN
         ISAVE( 3 ) = ISAVE( 3 ) + 1
         GO TO 50
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ITERATION COMPLETE.  FINAL STAGE.
</span><span class="comment">*</span><span class="comment">
</span>  100 CONTINUE
      ALTSGN = ONE
      DO 110 I = 1, N
         X( I ) = CMPLX( ALTSGN*( ONE + REAL( I-1 ) / REAL( N-1 ) ) )
         ALTSGN = -ALTSGN
  110 CONTINUE
      KASE = 1
      ISAVE( 1 ) = 5
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 5)
</span><span class="comment">*</span><span class="comment">     X HAS BEEN OVERWRITTEN BY A*X.
</span><span class="comment">*</span><span class="comment">
</span>  120 CONTINUE
      TEMP = TWO*( <a name="SCSUM1.209"></a><a href="scsum1.f.html#SCSUM1.1">SCSUM1</a>( N, X, 1 ) / REAL( 3*N ) )
      IF( TEMP.GT.EST ) THEN
         CALL CCOPY( N, X, 1, V, 1 )
         EST = TEMP
      END IF
<span class="comment">*</span><span class="comment">
</span>  130 CONTINUE
      KASE = 0
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="CLACN2.219"></a><a href="clacn2.f.html#CLACN2.1">CLACN2</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>
